home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH10 / SRC / OBJPICT6.CLS < prev    next >
Encoding:
Text File  |  1996-05-04  |  3.8 KB  |  148 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "ObjPicture"
  6. Attribute VB_Creatable = False
  7. Attribute VB_Exposed = False
  8. Option Explicit
  9.  
  10. Public objects As New Collection
  11.  
  12. Const TYPE_STRING = "3D APF PICTURE"
  13.  
  14.  
  15. ' ************************************************
  16. ' Find an object that contains this point.
  17. ' ************************************************
  18. Function NearestObject(x As Single, y As Single) As Object
  19. Dim obj As Object
  20.        
  21.     ' Find the object.
  22.     For Each obj In objects
  23.         If obj.Contains(x, y) Then
  24.             Set NearestObject = obj
  25.             Exit Function
  26.         End If
  27.     Next obj
  28.     Set NearestObject = Nothing
  29. End Function
  30.  
  31.  
  32. Function ObjectType() As String
  33.     ObjectType = TYPE_STRING
  34. End Function
  35. ' ***********************************************
  36. ' Fix the data coordinates at their transformed
  37. ' values.
  38. ' ***********************************************
  39. Public Sub FixPoints()
  40. Dim obj As Object
  41.  
  42.     For Each obj In objects
  43.         obj.FixPoints
  44.     Next obj
  45. End Sub
  46.  
  47. ' ************************************************
  48. ' Read the picture from a file using Input.
  49. ' Assume TYPE_STRING has already been read.
  50. ' ************************************************
  51. Sub FileInput(filenum As Integer)
  52. Dim num As Integer
  53. Dim i As Integer
  54. Dim obj As Object
  55. Dim obj_type As String
  56.  
  57.     ' Read the number of objects in the file.
  58.     Input #filenum, num
  59.     
  60.     ' Repeatedly read objects from the file.
  61.     For i = 1 To num
  62.         Input #filenum, obj_type
  63.         Select Case obj_type
  64.             Case TYPE_STRING
  65.                 Set obj = New ObjPicture
  66.             Case "POLYLINE"
  67.                 Set obj = New ObjPolyline
  68.             Case "GRID"
  69.                 Set obj = New ObjGrid3D
  70.             Case "SPARSE_GRID"
  71.                 Set obj = New ObjSparseGrid
  72.             Case "BEZIER"
  73.                 Set obj = New ObjBezier
  74.             Case "BSPLINE"
  75.                 Set obj = New ObjBSpline
  76.             Case Else
  77.                 Beep
  78.                 MsgBox "Unknown object type """ & obj_type & """.", , vbExclamation
  79.                 Exit Sub
  80.         End Select
  81.         obj.FileInput filenum
  82.         objects.Add obj
  83.     Next i
  84. End Sub
  85.  
  86. ' ************************************************
  87. ' Draw the picture on a Form, Printer, or
  88. ' PictureBox.
  89. ' ************************************************
  90. Sub Draw(canvas As Object, Optional r As Variant)
  91. Dim obj As Object
  92.  
  93.     For Each obj In objects
  94.         obj.Draw canvas, r
  95.     Next obj
  96. End Sub
  97.  
  98. ' ************************************************
  99. ' Write the picture to a file using Write.
  100. ' Begin with TYPE_STRING to identify this object.
  101. ' ************************************************
  102. Sub FileWrite(filenum As Integer)
  103. Dim obj As Object
  104.  
  105.     Write #filenum, TYPE_STRING
  106.     Write #filenum, objects.Count
  107.     
  108.     For Each obj In objects
  109.         obj.FileWrite filenum
  110.     Next obj
  111. End Sub
  112.  
  113. ' ************************************************
  114. ' Apply a nonlinear transformation to the objects.
  115. ' ************************************************
  116. Sub Distort(trans As Object)
  117. Dim obj As Object
  118.  
  119.     For Each obj In objects
  120.         obj.Distort trans
  121.     Next obj
  122. End Sub
  123.  
  124.  
  125. ' ************************************************
  126. ' Apply a transformation matrix which may not
  127. ' contain 0, 0, 0, 1 in the last column to the
  128. ' objects.
  129. ' ************************************************
  130. Sub ApplyFull(M() As Single)
  131. Dim obj As Object
  132.  
  133.     For Each obj In objects
  134.         obj.ApplyFull M
  135.     Next obj
  136. End Sub
  137. ' ************************************************
  138. ' Apply a transformation matrix to the objects.
  139. ' ************************************************
  140. Sub Apply(M() As Single)
  141. Dim obj As Object
  142.  
  143.     For Each obj In objects
  144.         obj.Apply M
  145.     Next obj
  146. End Sub
  147.  
  148.